home *** CD-ROM | disk | FTP | other *** search
/ Pascal Super Library / Pascal Super Library (CW International)(1997).bin / TURB_VIS / TCYBER25 / COMMON.ZIP / TVSTR.PAS < prev    next >
Pascal/Delphi Source File  |  1994-10-20  |  3KB  |  36 lines
  1. {
  2. Turbo Vision CyberTools 2.5
  3. (C) 1994 Steve Goldsmith
  4. All Rights Reserved
  5. }
  6.  
  7. UNIT TVSTR ;{$I APP.INC} INTERFACE USES DOS , DRIVERS ;CONST STRDOUBLEMAX :EXTENDED =1.7E308 ;
  8. STRDOUBLEMIN :EXTENDED =5E-324 ;FUNCTION INTTOSTR (L :LONGINT ):STRING ;FUNCTION INTTORIGHTSTR (L :LONGINT ;
  9. PLACES :INTEGER ):STRING ;FUNCTION STRTOINT (S :STRING ):LONGINT ;FUNCTION DBLTOSTR (D :DOUBLE ;L ,R:INTEGER ):STRING ;
  10. FUNCTION STRTODBL (S :STRING ):DOUBLE ;FUNCTION TRIMSTR (S :STRING ):STRING ;FUNCTION UPCASESTR (S :STRING ):STRING ;
  11. FUNCTION EXTSTRPOS (S :STRING ;VAR EXTPOS :WORD ):BOOLEAN ;FUNCTION ADDEXTSTR (S ,E:STRING ):STRING ;
  12. FUNCTION GETFILENAMESTR (S :STRING ):STRING ;FUNCTION FILLSTR (C :CHAR ;L :INTEGER ):STRING ;FUNCTION PADRIGHTSTR
  13. (S :STRING ;C :CHAR ;L :INTEGER ):STRING ;FUNCTION TIMESTR :STRING ;
  14. IMPLEMENTATION FUNCTION INTTOSTR (L:LONGINT):STRING ;VAR OO1O:STRING ;BEGIN STR (L , OO1O );INTTOSTR := OO1O END ;
  15. FUNCTION INTTORIGHTSTR (L:LONGINT;PLACES:INTEGER):STRING ;VAR OO1O:STRING ;BEGIN STR (L :PLACES , OO1O );INTTORIGHTSTR :=
  16. OO1O END ;FUNCTION STRTOINT (S:STRING ):LONGINT ;VAR Ol000OO00IlO:INTEGER;OO01:LONGINT;BEGIN VAL (S , OO01 , Ol000OO00IlO
  17. );STRTOINT := OO01 END ;FUNCTION DBLTOSTR (D:DOUBLE;L,R:INTEGER):STRING ;VAR OO1O:STRING ;BEGIN STR (D :L :R , OO1O );
  18. DBLTOSTR := OO1O END ;FUNCTION STRTODBL (S:STRING ):DOUBLE ;VAR Ol000OO00IlO:INTEGER;OIOl:EXTENDED;BEGIN VAL (S , OIOl ,
  19. Ol000OO00IlO );IF ((ABS (OIOl )>= STRDOUBLEMIN )AND (ABS (OIOl )<= STRDOUBLEMAX ))THEN STRTODBL := OIOl ELSE STRTODBL :=
  20. 0.0 END ;FUNCTION TRIMSTR (S:STRING ):STRING ;VAR OIlO:WORD;BEGIN WHILE (BYTE (S [ 0 ] )> 0 )AND (S [ BYTE (S [ 0 ] )] <=
  21. ' ') DO DEC (BYTE (S [ 0 ] ));OIlO := 1 ;WHILE (OIlO <= BYTE (S [ 0 ] ))AND (S [ OIlO ] <= ' ') DO INC (OIlO );DEC (OIlO
  22. );IF OIlO > 0 THEN DELETE (S , 1 , OIlO );TRIMSTR := S END ;FUNCTION UPCASESTR (S:STRING ):STRING ;VAR OIlO:INTEGER;
  23. BEGIN FOR OIlO := 1 TO BYTE (S [ 0 ] ) DO S [ OIlO ] := UPCASE (S [ OIlO ] );UPCASESTR := S END ;FUNCTION EXTSTRPOS
  24. (S:STRING ;VAR EXTPOS:WORD):BOOLEAN ;VAR OIlO:WORD;BEGIN EXTPOS := 0 ;FOR OIlO := BYTE (S [ 0 ] )DOWNTO 1  DO IF (S [
  25. OIlO ] ='.')AND (EXTPOS =0 )THEN EXTPOS := OIlO ;EXTSTRPOS := (EXTPOS > 0 )AND (POS ('\', COPY (S , SUCC (EXTPOS ),
  26. SIZEOF (PATHSTR )- 1 ))=0 )END ;FUNCTION ADDEXTSTR (S,E:STRING ):STRING ;VAR O10OIIlO0l0lI:WORD;BEGIN IF EXTSTRPOS (S ,
  27. O10OIIlO0l0lI )THEN ADDEXTSTR := COPY (S , 1 , O10OIIlO0l0lI )+ E ELSE ADDEXTSTR := S + '.'+ E END ;
  28. FUNCTION GETFILENAMESTR (S:STRING ):STRING ;VAR OO0O:PATHSTR;OIOO:DIRSTR;OIOl:EXTSTR;BEGIN FSPLIT (S , OIOO , OO0O , OIOl
  29. );GETFILENAMESTR := OO0O END ;FUNCTION FILLSTR (C:CHAR;L:INTEGER):STRING ;VAR OO1O:STRING ;BEGIN FILLCHAR (OO1O [ 1 ] , L
  30. , BYTE (C ));BYTE (OO1O [ 0 ] ):= L ;FILLSTR := OO1O END ;FUNCTION PADRIGHTSTR (S:STRING ;C:CHAR;L:INTEGER):STRING ;
  31. VAR OIlO,OOlI1O10III0:INTEGER;BEGIN OOlI1O10III0 := BYTE (S [ 0 ] )+ 1 ;FOR OIlO := OOlI1O10III0 TO L  DO S [ OIlO ] := C
  32. ;BYTE (S [ 0 ] ):= L ;PADRIGHTSTR := S END ;FUNCTION TIMESTR :STRING ;VAR OIlO:INTEGER;OIl0:LONGINT;OO1l:ARRAY [ 0 .. 3 ]
  33.  OF WORD;O11l0O1I:STRING [ 2 ] ;Ol00IO0II00O:STRING [ 11 ] ;BEGIN Ol00IO0II00O := '';GETTIME (OO1l [ 0 ] , OO1l [ 1 ] ,
  34. OO1l [ 2 ] , OO1l [ 3 ] );FOR OIlO := 0 TO 2  DO BEGIN OIl0 := OO1l [ OIlO ] ;FORMATSTR (O11l0O1I , '%02d', OIl0 );
  35. Ol00IO0II00O := Ol00IO0II00O + O11l0O1I + ':'END ;DEC (BYTE (Ol00IO0II00O [ 0 ] ));TIMESTR := Ol00IO0II00O END ;END .
  36.